home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / mana.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  56.2 KB  |  1,637 lines
  1. ;;; mana.scm: mana for uim.
  2. ;;; charset: EUC-JP
  3. ;;;
  4. ;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
  5. ;;;
  6. ;;; All rights reserved.
  7. ;;;
  8. ;;; Redistribution and use in source and binary forms, with or without
  9. ;;; modification, are permitted provided that the following conditions
  10. ;;; are met:
  11. ;;; 1. Redistributions of source code must retain the above copyright
  12. ;;;    notice, this list of conditions and the following disclaimer.
  13. ;;; 2. Redistributions in binary form must reproduce the above copyright
  14. ;;;    notice, this list of conditions and the following disclaimer in the
  15. ;;;    documentation and/or other materials provided with the distribution.
  16. ;;; 3. Neither the name of authors nor the names of its contributors
  17. ;;;    may be used to endorse or promote products derived from this software
  18. ;;;    without specific prior written permission.
  19. ;;;
  20. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
  21. ;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  22. ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  23. ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
  24. ;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  25. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  26. ;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  27. ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  28. ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  29. ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  30. ;;; SUCH DAMAGE.
  31. ;;;;
  32.  
  33. (require "util.scm")
  34. (require "ustr.scm")
  35. (require "japanese.scm")
  36. (require "japanese-kana.scm")
  37. (require "japanese-azik.scm")
  38. (require-custom "generic-key-custom.scm")
  39. (require-custom "mana-custom.scm")
  40. (require-custom "mana-key-custom.scm")
  41.  
  42.  
  43. ;;; implementations
  44.  
  45. (define mana-segment-rec-spec
  46.   (list
  47.     (list 'first-candidate  #f)
  48.     (list 'pos               0)
  49.     (list 'len               0)
  50.     (list 'state             0)
  51.     (list 'candidate-list  '())
  52.     (list 'candidate-pos     0)
  53.     (list 'nr-candidates     0)))
  54.  
  55. (define-record 'mana-segment mana-segment-rec-spec)
  56. (define mana-segment-new-internal mana-segment-new)
  57.  
  58. (define mana-segment-new
  59.   (lambda (first-candidate pos len state cost)
  60.     (mana-segment-new-internal first-candidate pos len state)))
  61.  
  62.  
  63. (define mana-best-path
  64.   (lambda (yomi state pos len)
  65.     (mana-eval (list 'mana-best-path yomi state pos len))))
  66.  
  67. (define mana-list-candidates
  68.   (lambda (yomi state pos mrph-len len)
  69.     (mana-eval (list 'mana-list-candidates yomi state pos mrph-len len))))
  70.  
  71. (define mana-add-new-word
  72.   (lambda (kaki yomi)
  73.     (mana-eval (list 'mana-add-new-word kaki yomi))))
  74.  
  75. (define mana-learn
  76.   (lambda (yomi state pos len path)
  77.     (mana-eval (list 'mana-learn yomi state pos len (list 'quote path)))))
  78.  
  79. (define mana-eval
  80.   (lambda (val)
  81.     (mana-lib-eval (string-append (mana-list->string val) "\n"))))
  82.  
  83. (define mana-list->string
  84.   (lambda (lst)
  85.     (let ((canonicalized (map (lambda (elem)
  86.                                 (cond
  87.                                   ((symbol? elem)
  88.                                    (symbol->string elem))
  89.                                   ((string? elem)
  90.                                    (string-escape elem))
  91.                                   ((number? elem)
  92.                                    (number->string elem))
  93.                                   ((list? elem)
  94.                                    (mana-list->string elem))
  95.                                   (else
  96.                                     "")))
  97.                               lst)))
  98.       (string-append "(" (string-join canonicalized " ") ")"))))
  99.  
  100. (define mana-set-string!
  101.   (lambda (mc yomi yomi-len)
  102.     (let ((best-path (mana-best-path yomi 0 0 yomi-len)))
  103.       (if (not best-path)
  104.           #f
  105.           (let ((nr-segments (length best-path))
  106.                 (segment-list (mana-make-segment-list best-path)))
  107.             (mana-context-set-yomi! mc yomi)
  108.             (mana-context-set-yomi-len! mc yomi-len)
  109.             (mana-context-set-nr-segments! mc nr-segments)
  110.             (mana-context-set-segment-list! mc segment-list)
  111.             #t)))))
  112.  
  113. (define mana-make-segment-list
  114.   (lambda (best-path)
  115.     (map
  116.       (lambda (segment)
  117.         (apply mana-segment-new segment))
  118.       best-path)))
  119.  
  120. (define mana-get-nth-path
  121.   (lambda (mc seg-idx cand-idx)
  122.     (let* ((segment-list (mana-context-segment-list mc))
  123.            (segment (list-ref segment-list seg-idx))
  124.            (pos (mana-segment-pos segment))
  125.            (len (mana-segment-len segment)))
  126.       (list
  127.         (if (= cand-idx 0)
  128.             (mana-segment-first-candidate segment)
  129.             (begin
  130.               (if (null? (mana-segment-candidate-list segment))
  131.                   (mana-set-candidate-list! mc seg-idx))
  132.               (list-ref (mana-segment-candidate-list segment)
  133.                         cand-idx)))
  134.         pos len))))
  135.  
  136. (define mana-get-raw-str-seq
  137.   (lambda (mc)
  138.     (let* ((rkc (mana-context-rkc mc))
  139.        (pending (rk-pending rkc))
  140.        (residual-kana (rk-peek-terminal-match rkc))
  141.        (raw-str (mana-context-raw-ustr mc))
  142.        (right-str (ustr-latter-seq raw-str))
  143.        (left-str (ustr-former-seq raw-str)))
  144.      (append left-str
  145.          (if residual-kana
  146.          (list pending)
  147.          '())
  148.          right-str))))
  149.  
  150. (define mana-get-raw-candidate
  151.   (lambda (mc seg-idx cand-idx)
  152.     (let* ((yomi (mana-context-yomi mc))
  153.        (yomi-len (mana-context-yomi-len mc))
  154.            (segment-list (mana-context-segment-list mc))
  155.        (segment (list-ref segment-list seg-idx))
  156.        (len (mana-segment-len segment))
  157.        (pos (mana-segment-pos segment))
  158.        (preconv (ja-join-vu (string-to-list yomi)))
  159.        (unconv (ja-join-vu (sublist
  160.                 (string-to-list yomi)
  161.                 (- yomi-len (+ pos len))
  162.                 (- yomi-len pos))))
  163.        (raw-str (reverse (mana-get-raw-str-seq mc))))
  164.      (cond
  165.       ((= cand-idx mana-candidate-type-hiragana)
  166.        (string-list-concat unconv))
  167.       ((= cand-idx mana-candidate-type-katakana)
  168.        (ja-make-kana-str (ja-make-kana-str-list unconv) mana-type-katakana))
  169.       ((= cand-idx mana-candidate-type-halfkana)
  170.        (ja-make-kana-str (ja-make-kana-str-list unconv) mana-type-halfkana))
  171.       (else
  172.        (if (not (null? unconv))
  173.        (if (member (car unconv) preconv)
  174.            (let ((start (list-seq-contained? preconv unconv))
  175.              (len (length unconv)))
  176.          (if start
  177.              (mana-make-raw-string
  178.               (reverse (sublist-rel raw-str start len))
  179.               (if (or
  180.                (= cand-idx mana-candidate-type-halfwidth-alnum)
  181.                (= cand-idx
  182.                   mana-candidate-type-upper-halfwidth-alnum))
  183.               #f
  184.               #t)
  185.               (if (or
  186.                (= cand-idx mana-candidate-type-halfwidth-alnum)
  187.                (= cand-idx mana-candidate-type-fullwidth-alnum))
  188.               #f
  189.               #t))
  190.              "??")) ;; FIXME
  191.            "???") ;; FIXME
  192.        "????"))))))
  193.  
  194. (define mana-get-nth-candidate
  195.   (lambda (mc seg-idx cand-idx)
  196.     (if (> cand-idx mana-candidate-type-katakana)
  197.     (car (mana-get-nth-path mc seg-idx cand-idx))
  198.     (mana-get-raw-candidate mc seg-idx cand-idx))))
  199.  
  200. (define mana-get-nr-candidates
  201.   (lambda (mc seg-idx)
  202.     (let* ((segment-list (mana-context-segment-list mc))
  203.            (segment (list-ref segment-list seg-idx)))
  204.       (if (null? (mana-segment-candidate-list segment))
  205.           (mana-set-candidate-list! mc seg-idx))
  206.       (mana-segment-nr-candidates segment))))
  207.  
  208. (define mana-uniq
  209.   (lambda (lst)
  210.     (reverse (fold
  211.                (lambda (x xs)
  212.                  (if (member x xs)
  213.                      xs
  214.                      (cons x xs)))
  215.                '() lst))))
  216.  
  217. (define mana-set-candidate-list!
  218.   (lambda (mc seg-idx)
  219.     (let* ((segment-list (mana-context-segment-list mc))
  220.            (segment (list-ref segment-list seg-idx))
  221.            (yomi (mana-context-yomi mc))
  222.            (state
  223.              (if (= seg-idx 0)
  224.                  0
  225.                  (mana-segment-state
  226.                    (list-ref segment-list (- seg-idx 1)))))
  227.            (pos  (mana-segment-pos segment))
  228.            (len  (mana-segment-len segment))
  229.            (first-candidate (mana-segment-first-candidate segment))
  230.            (uniq-candidate-list
  231.              (mana-uniq
  232.                (cons
  233.                  first-candidate
  234.                  (map car (mana-list-candidates yomi state pos len len))))))
  235.       (mana-segment-set-candidate-list!
  236.         segment uniq-candidate-list)
  237.       (mana-segment-set-nr-candidates!
  238.         segment (length uniq-candidate-list)))))
  239.  
  240. (define mana-resize-specified-segment
  241.   (lambda (mc seg-idx cnt)
  242.     (let* ((yomi (mana-context-yomi mc))
  243.            (segment-list (mana-context-segment-list mc))
  244.            (segment (list-ref segment-list seg-idx))
  245.            (state (mana-segment-state segment))
  246.            (len (mana-segment-len segment))
  247.            (new-len (+ len cnt))
  248.            (pos (mana-segment-pos segment))
  249.            (next-segment-pos (+ pos new-len))
  250.            (end-of-yomi (- (mana-context-yomi-len mc) next-segment-pos)))
  251.       (if (and (> new-len 0)
  252.                (>= end-of-yomi 0))
  253.           (let* ((cand-state-list (mana-list-candidates yomi state pos new-len new-len))
  254.                  (first-candidate (caar cand-state-list))
  255.                  (next-state (car (cdar cand-state-list)))
  256.                  (best-path (mana-best-path yomi next-state next-segment-pos end-of-yomi))
  257.                  (uniq-candidate-list (mana-uniq (map car cand-state-list))))
  258.             (mana-segment-set-len! segment new-len)
  259.             (mana-segment-set-first-candidate! segment first-candidate)
  260.             (mana-segment-set-candidate-list! segment uniq-candidate-list)
  261.             (mana-segment-set-nr-candidates! segment (length uniq-candidate-list))
  262.             (mana-context-set-nr-segments! mc (+ seg-idx 1 (length best-path)))
  263.             (set-cdr! (list-tail segment-list seg-idx)
  264.                       (mana-make-segment-list best-path)))))))
  265.  
  266.  
  267.  
  268. (define mana-lib-initialized? #f)
  269.  
  270. (define mana-type-direct          ja-type-direct)
  271. (define mana-type-hiragana        ja-type-hiragana)
  272. (define mana-type-katakana        ja-type-katakana)
  273. (define mana-type-halfkana        ja-type-halfkana)
  274. (define mana-type-halfwidth-alnum ja-type-halfwidth-alnum)
  275. (define mana-type-fullwidth-alnum ja-type-fullwidth-alnum)
  276.  
  277. (define mana-input-rule-roma 0)
  278. (define mana-input-rule-kana 1)
  279. (define mana-input-rule-azik 2)
  280.  
  281. (define mana-candidate-type-katakana -2)
  282. (define mana-candidate-type-hiragana -3)
  283. (define mana-candidate-type-halfkana -4)
  284. (define mana-candidate-type-halfwidth-alnum -5)
  285. (define mana-candidate-type-fullwidth-alnum -6)
  286. (define mana-candidate-type-upper-halfwidth-alnum -7)
  287. (define mana-candidate-type-upper-fullwidth-alnum -8)
  288.  
  289. ;; I don't think the key needs to be customizable.
  290. (define-key mana-space-key? '(" "))
  291.  
  292. (define mana-prepare-input-rule-activation
  293.   (lambda (mc)
  294.     (cond
  295.      ((mana-context-converting mc)
  296.       (mana-do-commit mc))
  297.      ((mana-context-transposing mc)
  298.       (im-commit mc (mana-transposint-text mc)))
  299.      ((and
  300.        (mana-context-on mc)
  301.        (mana-has-preedit? mc))
  302.       (im-commit
  303.        mc (mana-make-whole-string mc #t (mana-context-kana-mode mc)))))
  304.     (mana-flush mc)
  305.     (mana-update-preedit mc)))
  306.  
  307. (define mana-prepare-input-mode-activation
  308.   (lambda (mc new-mode)
  309.     (let ((old-kana (mana-context-kana-mode mc)))
  310.       (cond
  311.        ((mana-context-converting mc)
  312.     (mana-do-commit mc))
  313.        ((mana-context-transposing mc)
  314.     (im-commit mc (mana-transposint-text mc))
  315.     (mana-flush mc))
  316.        ((and
  317.      (mana-context-on mc)
  318.      (mana-has-preedit? mc)
  319.      (not (= old-kana new-mode)))
  320.     (im-commit
  321.      mc (mana-make-whole-string mc #t (mana-context-kana-mode mc)))
  322.     (mana-flush mc)))
  323.     (mana-update-preedit mc))))
  324.  
  325. (register-action 'action_mana_hiragana
  326.                  ;;              (indication-alist-indicator 'action_mana_hiragana
  327.                  ;;                                          mana-input-mode-indication-alist)
  328.                  (lambda (mc) ;; indication handler
  329.                    '(ja_hiragana
  330.                       "ñó"
  331.                       "ñ╥ñΘñ¼ñ╩"
  332.                       "ñ╥ñΘñ¼ñ╩╞■╬╧ÑΓí╝Ñ╔"))
  333.  
  334.                  (lambda (mc) ;; activity predicate
  335.                    (and (mana-context-on mc)
  336.             (not (mana-context-alnum mc))
  337.                         (= (mana-context-kana-mode mc)
  338.                            mana-type-hiragana)))
  339.  
  340.                  (lambda (mc) ;; action handler
  341.            (mana-prepare-input-mode-activation mc mana-type-hiragana)
  342.                    (mana-context-set-on! mc #t)
  343.            (mana-context-set-alnum! mc #f)
  344.                    (mana-context-change-kana-mode! mc mana-type-hiragana)))
  345.  
  346. (register-action 'action_mana_katakana
  347.                  ;;              (indication-alist-indicator 'action_mana_katakana
  348.                  ;;                                          mana-input-mode-indication-alist)
  349.                  (lambda (mc)
  350.                    '(ja_katakana
  351.                       "Ñó"
  352.                       "ѽÑ┐ѽÑ╩"
  353.                       "ѽÑ┐ѽÑ╩╞■╬╧ÑΓí╝Ñ╔"))
  354.                  (lambda (mc)
  355.                    (and (mana-context-on mc)
  356.             (not (mana-context-alnum mc))
  357.                         (= (mana-context-kana-mode mc)
  358.                            mana-type-katakana)))
  359.                  (lambda (mc)
  360.            (mana-prepare-input-mode-activation mc mana-type-katakana)
  361.                    (mana-context-set-on! mc #t)
  362.            (mana-context-set-alnum! mc #f)
  363.                    (mana-context-change-kana-mode! mc mana-type-katakana)))
  364.  
  365. (register-action 'action_mana_halfkana
  366.                  ;;              (indication-alist-indicator 'action_mana_halfkana
  367.                  ;;                                          mana-input-mode-indication-alist)
  368.                  (lambda (mc)
  369.                    '(ja_halfkana
  370.                       "Ä▒"
  371.                       "╚╛│╤ѽÑ┐ѽÑ╩"
  372.                       "╚╛│╤ѽÑ┐ѽÑ╩╞■╬╧ÑΓí╝Ñ╔"))
  373.                  (lambda (mc)
  374.                    (and (mana-context-on mc)
  375.             (not (mana-context-alnum mc))
  376.                         (= (mana-context-kana-mode mc)
  377.                            mana-type-halfkana)))
  378.                  (lambda (mc)
  379.            (mana-prepare-input-mode-activation mc mana-type-halfkana)
  380.                    (mana-context-set-on! mc #t)
  381.            (mana-context-set-alnum! mc #f)
  382.                    (mana-context-change-kana-mode! mc mana-type-halfkana)))
  383.  
  384. (register-action 'action_mana_halfwidth_alnum
  385.          (lambda (mc)
  386.            '(ja_halfwidth_alnum
  387.              "a"
  388.              "╚╛│╤▒╤┐⌠"
  389.              "╚╛│╤▒╤┐⌠╞■╬╧ÑΓí╝Ñ╔"))
  390.          (lambda (mc)
  391.            (and (mana-context-on mc)
  392.             (mana-context-alnum mc)
  393.             (= (mana-context-alnum-type mc)
  394.                mana-type-halfwidth-alnum)))
  395.          (lambda (mc)
  396.            (mana-prepare-input-mode-activation
  397.             mc (mana-context-kana-mode mc))
  398.            (mana-context-set-on! mc #t)
  399.            (mana-context-set-alnum! mc #t)
  400.            (mana-context-set-alnum-type!
  401.             mc mana-type-halfwidth-alnum)))
  402.  
  403. (register-action 'action_mana_direct
  404.                  ;;              (indication-alist-indicator 'action_mana_direct
  405.                  ;;                                          mana-input-mode-indication-alist)
  406.                  (lambda (mc)
  407.                    '(ja_direct
  408.                       "-"
  409.                       "─╛└▄╞■╬╧"
  410.                       "─╛└▄(╠╡╩╤┤╣)╞■╬╧ÑΓí╝Ñ╔"))
  411.                  (lambda (mc)
  412.                    (not (mana-context-on mc)))
  413.                  (lambda (mc)
  414.                    (mana-prepare-input-mode-activation mc mana-type-direct)
  415.                    (mana-context-set-on! mc #f)))
  416.  
  417. (register-action 'action_mana_fullwidth_alnum
  418.                  ;;              (indication-alist-indicator 'action_mana_fullwidth_alnum
  419.                  ;;                                          mana-input-mode-indication-alist)
  420.                  (lambda (mc)
  421.                    '(ja_fullwidth_alnum
  422.                       "ú┴"
  423.                       "┴┤│╤▒╤┐⌠"
  424.                       "┴┤│╤▒╤┐⌠╞■╬╧ÑΓí╝Ñ╔"))
  425.                  (lambda (mc)
  426.                    (and (mana-context-on mc)
  427.                         (mana-context-alnum mc)
  428.             (= (mana-context-alnum-type mc)
  429.                mana-type-fullwidth-alnum)))
  430.                  (lambda (mc)
  431.                    (mana-prepare-input-mode-activation
  432.             mc (mana-context-kana-mode mc))
  433.                    (mana-context-set-on! mc #t)
  434.            (mana-context-set-alnum! mc #t)
  435.                    (mana-context-set-alnum-type!
  436.             mc mana-type-fullwidth-alnum)))
  437.  
  438. (register-action 'action_mana_roma
  439.                  ;;              (indication-alist-indicator 'action_mana_roma
  440.                  ;;                                          mana-kana-input-method-indication-alist)
  441.                  (lambda (mc)
  442.                    '(ja_romaji
  443.                       "ú╥"
  444.                       "Ñφí╝Ñ▐╗·"
  445.                       "Ñφí╝Ñ▐╗·╞■╬╧ÑΓí╝Ñ╔"))
  446.                  (lambda (mc)
  447.                    (= (mana-context-input-rule mc)
  448.                       mana-input-rule-roma))
  449.                  (lambda (mc)
  450.                    (mana-prepare-input-rule-activation mc)
  451.                    (rk-context-set-rule! (mana-context-rkc mc)
  452.                                          ja-rk-rule)
  453.                    (mana-context-set-input-rule! mc mana-input-rule-roma)))
  454.  
  455. (register-action 'action_mana_kana
  456.                  ;;              (indication-alist-indicator 'action_mana_kana
  457.                  ;;                                          mana-kana-input-method-indication-alist)
  458.                  (lambda (mc)
  459.                    '(ja_kana
  460.                       "ñ½"
  461.                       "ñ½ñ╩"
  462.                       "ñ½ñ╩╞■╬╧ÑΓí╝Ñ╔"))
  463.                  (lambda (mc)
  464.                    (= (mana-context-input-rule mc)
  465.                       mana-input-rule-kana))
  466.                  (lambda (mc)
  467.                    (mana-prepare-input-rule-activation mc)
  468.                    (mana-context-set-input-rule! mc mana-input-rule-kana)
  469.                    (mana-context-change-kana-mode!
  470.             mc (mana-context-kana-mode mc))
  471.            (mana-context-set-alnum! mc #f)
  472.                    ;;(define-key mana-kana-toggle-key? "")
  473.                    ;;(define-key mana-on-key? generic-on-key?)
  474.                    ;;(define-key mana-fullwidth-alnum-key? "")
  475.                    ))
  476.  
  477. (register-action 'action_mana_azik
  478.                  ;;              (indication-alist-indicator 'action_mana_azik
  479.                  ;;                                          mana-kana-input-method-indication-alist)
  480.                  (lambda (mc)
  481.                    '(ja_azik
  482.                       "ú┌"
  483.                       "AZIK"
  484.                       "AZIK│╚─ÑÑφí╝Ñ▐╗·╞■╬╧ÑΓí╝Ñ╔"))
  485.                  (lambda (mc)
  486.                    (= (mana-context-input-rule mc)
  487.                       mana-input-rule-azik))
  488.                  (lambda (mc)
  489.                    (mana-prepare-input-rule-activation mc)
  490.                    (rk-context-set-rule! (mana-context-rkc mc)
  491.                                          ja-azik-rule)
  492.                    (mana-context-set-input-rule! mc mana-input-rule-azik)))
  493.  
  494. ;; Update widget definitions based on action configurations. The
  495. ;; procedure is needed for on-the-fly reconfiguration involving the
  496. ;; custom API
  497. (define mana-configure-widgets
  498.   (lambda ()
  499.     (register-widget 'widget_mana_input_mode
  500.                      (activity-indicator-new mana-input-mode-actions)
  501.                      (actions-new mana-input-mode-actions))
  502.  
  503.     (register-widget 'widget_mana_kana_input_method
  504.                      (activity-indicator-new mana-kana-input-method-actions)
  505.                      (actions-new mana-kana-input-method-actions))
  506.     (context-list-replace-widgets! 'mana mana-widgets)))
  507.  
  508. (define mana-context-rec-spec
  509.   (append
  510.     context-rec-spec
  511.     (list
  512.       (list 'on                 #f)
  513.       (list 'converting         #f)
  514.       (list 'transposing        #f)
  515.       (list 'transposing-type    0)
  516.       (list 'nr-segments         0)
  517.       (list 'segment-list      '())
  518.       (list 'yomi               #f)
  519.       (list 'yomi-len            0)
  520.       (list 'preconv-ustr       #f) ;; preedit strings
  521.       (list 'rkc                #f)
  522.       (list 'segments           #f) ;; ustr of candidate indices
  523.       (list 'candidate-window   #f)
  524.       (list 'candidate-op-count 0)
  525.       (list 'kana-mode          mana-type-hiragana)
  526.       (list 'alnum              #f)
  527.       (list 'alnum-type         mana-type-halfwidth-alnum)
  528.       (list 'commit-raw         #t)
  529.       (list 'input-rule         mana-input-rule-roma)
  530.       (list 'raw-ustr           #f))))
  531. (define-record 'mana-context mana-context-rec-spec)
  532. (define mana-context-new-internal mana-context-new)
  533.  
  534. (define mana-context-new
  535.   (lambda (id im)
  536.     (let ((mc (mana-context-new-internal id im))
  537.           (rkc (rk-context-new ja-rk-rule #t #f)))
  538.       (if (not mana-lib-initialized?)
  539.           (set! mana-lib-initialized? (mana-lib-init)))
  540.       (mana-context-set-widgets! mc mana-widgets)
  541.       (mana-context-set-rkc! mc rkc)
  542.       (mana-context-set-preconv-ustr! mc (ustr-new '()))
  543.       (mana-context-set-raw-ustr! mc (ustr-new '()))
  544.       (mana-context-set-segments! mc (ustr-new '()))
  545.  
  546.       ;; 2004-08-26 Takuro Ashie <ashie@homa.ne.jp>
  547.       ;;   * I think load-kana-table should be marked as depracated.
  548.       ;;     Because it is a little violent (it overwrites ja-rk-rule table).
  549.       ;;     We should prepare a custom entry like "uim-default-input-rule"
  550.       ;;     instead of using-kana-table.
  551.       (if using-kana-table?
  552.           (mana-context-set-input-rule! mc mana-input-rule-kana)
  553.           (mana-context-set-input-rule! mc mana-input-rule-roma))
  554.       mc)))
  555.  
  556. (define mana-commit-raw
  557.   (lambda (mc)
  558.     (im-commit-raw mc)
  559.     (mana-context-set-commit-raw! mc #t)))
  560.  
  561. (define mana-context-kana-toggle
  562.   (lambda (mc)
  563.     (let* ((kana (mana-context-kana-mode mc))
  564.        (opposite-kana (ja-opposite-kana kana)))
  565.       (mana-context-change-kana-mode! mc opposite-kana))))
  566.  
  567. (define mana-context-alkana-toggle
  568.   (lambda (mc)
  569.     (let ((alnum-state (mana-context-alnum mc)))
  570.       (mana-context-set-alnum! mc (not alnum-state)))))
  571.     
  572. (define mana-context-change-kana-mode!
  573.   (lambda (mc kana-mode)
  574.     (if (= (mana-context-input-rule mc)
  575.            mana-input-rule-kana)
  576.         (rk-context-set-rule!
  577.      (mana-context-rkc mc)
  578.      (cond
  579.       ((= kana-mode mana-type-hiragana) ja-kana-hiragana-rule)
  580.       ((= kana-mode mana-type-katakana) ja-kana-katakana-rule)
  581.       ((= kana-mode mana-type-halfkana)  ja-kana-halfkana-rule))))
  582.     (mana-context-set-kana-mode! mc kana-mode)))
  583.  
  584. ;; TODO: generarize as multi-segment procedure
  585. ;; side effect: none. rkc will not be altered
  586. (define mana-make-whole-string
  587.   (lambda (mc convert-pending-into-kana? kana)
  588.     (let* ((rkc (mana-context-rkc mc))
  589.            (pending (rk-pending rkc))
  590.            (residual-kana (rk-peek-terminal-match rkc))
  591.            (rule (mana-context-input-rule mc))
  592.            (preconv-str (mana-context-preconv-ustr mc))
  593.            (extract-kana
  594.              (if (= rule mana-input-rule-kana)
  595.                  (lambda (entry) (car entry))
  596.                  (lambda (entry) (list-ref entry kana)))))
  597.  
  598.       (if (= rule mana-input-rule-kana)
  599.       (ja-make-kana-str
  600.        (ja-make-kana-str-list
  601.         (string-to-list
  602.          (string-append
  603.           (string-append-map-ustr-former extract-kana preconv-str)
  604.           (if convert-pending-into-kana?
  605.           (if residual-kana
  606.               (extract-kana residual-kana)
  607.               pending)
  608.           pending)
  609.           (string-append-map-ustr-latter extract-kana preconv-str))))
  610.        kana)
  611.       (string-append
  612.        (string-append-map-ustr-former extract-kana preconv-str)
  613.        (if convert-pending-into-kana?
  614.            (if residual-kana
  615.            (extract-kana residual-kana)
  616.                    "")
  617.            pending)
  618.        (string-append-map-ustr-latter extract-kana preconv-str))))))
  619.  
  620. (define mana-make-raw-string
  621.   (lambda (raw-str-list wide? upper?)
  622.     (if (not (null? raw-str-list))
  623.         (if wide?
  624.             (string-append
  625.           (ja-string-list-to-wide-alphabet 
  626.         (if upper?
  627.             (map charcode->string
  628.              (map ichar-upcase
  629.                   (map string->charcode
  630.                    (string-to-list (car raw-str-list)))))
  631.             (string-to-list (car raw-str-list))))
  632.           (mana-make-raw-string (cdr raw-str-list) wide? upper?))
  633.             (string-append
  634.           (if upper?
  635.           (string-list-concat
  636.            (map charcode->string
  637.             (map ichar-upcase
  638.                  (map string->charcode
  639.                   (string-to-list (car raw-str-list))))))
  640.           (car raw-str-list))
  641.               (mana-make-raw-string (cdr raw-str-list) wide? upper?)))
  642.         "")))
  643.  
  644. (define mana-make-whole-raw-string
  645.   (lambda (mc wide? upper?)
  646.     (mana-make-raw-string (mana-get-raw-str-seq mc) wide? upper?)))
  647.  
  648. (define mana-init-handler
  649.   (lambda (id im arg)
  650.     (mana-context-new id im)))
  651.  
  652. (define mana-release-handler
  653.   (lambda (mc)
  654.     '()))
  655.  
  656. (define mana-flush
  657.   (lambda (mc)
  658.     (rk-flush (mana-context-rkc mc))
  659.     (ustr-clear! (mana-context-preconv-ustr mc))
  660.     (ustr-clear! (mana-context-raw-ustr mc))
  661.     (ustr-clear! (mana-context-segments mc))
  662.     (mana-context-set-transposing! mc #f)
  663.     (mana-context-set-converting! mc #f)
  664.     (mana-context-set-nr-segments! mc 0)
  665.     (mana-context-set-segment-list! mc '())
  666.     (mana-context-set-yomi! mc #f)
  667.     (mana-context-set-yomi-len! mc 0)
  668.     (if (mana-context-candidate-window mc)
  669.         (im-deactivate-candidate-selector mc))
  670.     (mana-context-set-candidate-window! mc #f)
  671.     (mana-context-set-candidate-op-count! mc 0)))
  672.  
  673. (define mana-begin-input
  674.   (lambda (mc key key-state)
  675.     (if (cond
  676.      ((mana-on-key? key key-state)
  677.       #t)
  678.      ((and
  679.        mana-use-mode-transition-keys-in-off-mode?
  680.        (cond
  681.         ((mana-hiragana-key? key key-state)
  682.          (mana-context-set-kana-mode! mc mana-type-hiragana)
  683.          (mana-context-set-alnum! mc #f)
  684.          #t)
  685.         ((mana-katakana-key? key key-state)
  686.          (mana-context-set-kana-mode! mc mana-type-katakana)
  687.          (mana-context-set-alnum! mc #f)
  688.          #t)
  689.         ((mana-halfkana-key? key key-state)
  690.          (mana-context-set-kana-mode! mc mana-type-halfkana)
  691.          (mana-context-set-alnum! mc #f)
  692.          #t)
  693.         ((mana-halfwidth-alnum-key? key key-state)
  694.          (mana-context-set-alnum-type mc mana-type-halfwidth-alnum)
  695.          (mana-context-set-alnum! mc #t)
  696.          #t)
  697.         ((mana-fullwidth-alnum-key? key key-state)
  698.          (mana-context-set-alnum-type mc mana-type-fullwidth-alnum)
  699.          (mana-context-set-alnum! mc #t)
  700.          #t)
  701.         ((mana-kana-toggle-key? key key-state)
  702.          (mana-context-kana-toggle mc)
  703.          (mana-context-set-alnum! mc #f)
  704.          #t)
  705.         ((mana-alkana-toggle-key? key key-state)
  706.          (mana-context-alkana-toggle mc)
  707.          #t)
  708.         (else
  709.          #f))))
  710.      (else
  711.       #f))
  712.     (begin
  713.       (mana-context-set-on! mc #t)
  714.       (rk-flush (mana-context-rkc mc))
  715.       (mana-context-set-converting! mc #f)
  716.       #t)
  717.     #f)))
  718.  
  719. (define mana-update-preedit
  720.   (lambda (mc)
  721.     (if (not (mana-context-commit-raw mc))
  722.         (let ((segments (if (mana-context-on mc)
  723.                             (if (mana-context-transposing mc)
  724.                                 (mana-context-transposing-state-preedit mc)
  725.                                 (if (mana-context-converting mc)
  726.                                     (mana-converting-state-preedit mc)
  727.                                     (mana-input-state-preedit mc)))
  728.                             ())))
  729.           (context-update-preedit mc segments))
  730.         (mana-context-set-commit-raw! mc #f))))
  731.  
  732. (define mana-proc-raw-state
  733.   (lambda (mc key key-state)
  734.     (if (not (mana-begin-input mc key key-state))
  735.         (mana-commit-raw mc))))
  736.  
  737. (define mana-begin-conv
  738.   (lambda (mc)
  739.     (let* (
  740.            (kana (mana-context-kana-mode mc))
  741.            (preconv-str (mana-make-whole-string mc #t mana-type-hiragana))
  742.            (yomi-len (mana-lib-eucjp-string-length preconv-str)))
  743.       (if (and mana-lib-initialized?
  744.                (> (string-length preconv-str)
  745.                   0))
  746.           (if (mana-set-string! mc preconv-str yomi-len)
  747.               (let ((nr-segments (mana-context-nr-segments mc)))
  748.                 (ustr-set-latter-seq! (mana-context-segments mc)
  749.                                       (make-list nr-segments 0))
  750.                 (mana-context-set-converting! mc #t)
  751.                 ;; Don't perform rk-flush here. The rkc must be restored when
  752.                 ;; mana-cancel-conv invoked -- YamaKen 2004-10-25
  753.                 ))))))
  754.  
  755. (define mana-cancel-conv
  756.   (lambda (mc)
  757.     (mana-reset-candidate-window mc)
  758.     (mana-context-set-converting! mc #f)
  759.     (mana-context-set-nr-segments! mc 0)
  760.     (mana-context-set-segment-list! mc '())
  761.     (mana-context-set-yomi! mc #f)
  762.     (mana-context-set-yomi-len! mc 0)
  763.     (ustr-clear! (mana-context-segments mc))))
  764.  
  765. (define mana-proc-input-state-no-preedit
  766.   (lambda (mc key key-state)
  767.     (let ((rkc (mana-context-rkc mc))
  768.           (direct (ja-direct (charcode->string key)))
  769.           (rule (mana-context-input-rule mc)))
  770.       (cond
  771.         ((and mana-use-with-vi?
  772.               (mana-vi-escape-key? key key-state))
  773.      (mana-flush mc)
  774.      (mana-context-set-on! mc #f)
  775.      (mana-commit-raw mc))
  776.  
  777.         ((mana-off-key? key key-state)
  778.      (mana-flush mc)
  779.      (mana-context-set-on! mc #f))
  780.  
  781.         ((mana-backspace-key? key key-state)
  782.          (mana-commit-raw mc))
  783.  
  784.         ((mana-delete-key? key key-state)
  785.          (mana-commit-raw mc))
  786.  
  787.     ((and
  788.       (mana-hiragana-key? key key-state)
  789.       (not
  790.        (and
  791.         (= (mana-context-kana-mode mc) mana-type-hiragana)
  792.         (not (mana-context-alnum mc)))))
  793.      (mana-context-change-kana-mode! mc mana-type-hiragana)
  794.      (mana-context-set-alnum! mc #f))
  795.  
  796.     ((and
  797.       (mana-katakana-key? key key-state)
  798.       (not
  799.        (and
  800.         (= (mana-context-kana-mode mc) mana-type-katakana)
  801.         (not (mana-context-alnum mc)))))
  802.      (mana-context-change-kana-mode! mc mana-type-katakana)
  803.      (mana-context-set-alnum! mc #f))
  804.  
  805.     ((and
  806.       (mana-halfkana-key? key key-state)
  807.       (not
  808.        (and
  809.         (= (mana-context-kana-mode mc) mana-type-halfkana)
  810.         (not (mana-context-alnum mc)))))
  811.      (mana-context-change-kana-mode! mc mana-type-halfkana)
  812.      (mana-context-set-alnum! mc #f))
  813.  
  814.     ((and
  815.       (mana-halfwidth-alnum-key? key key-state)
  816.       (not
  817.        (and
  818.         (= (mana-context-alnum-type mc) mana-type-halfwidth-alnum)
  819.         (mana-context-alnum mc))))
  820.      (mana-context-set-alnum-type! mc mana-type-halfwidth-alnum)
  821.      (mana-context-set-alnum! mc #t))
  822.  
  823.     ((and
  824.       (mana-fullwidth-alnum-key? key key-state)
  825.       (not
  826.        (and
  827.         (= (mana-context-alnum-type mc) mana-type-fullwidth-alnum)
  828.         (mana-context-alnum mc))))
  829.      (mana-context-set-alnum-type! mc mana-type-fullwidth-alnum)
  830.      (mana-context-set-alnum! mc #t))
  831.  
  832.     ((and
  833.       (not (mana-context-alnum mc))
  834.       (mana-kana-toggle-key? key key-state))
  835.          (mana-context-kana-toggle mc))
  836.  
  837.     ((mana-alkana-toggle-key? key key-state)
  838.      (mana-context-alkana-toggle mc))
  839.  
  840.         ;; modifiers (except shift) => ignore
  841.         ((and (modifier-key-mask key-state)
  842.               (not (shift-key-mask key-state)))
  843.          (mana-commit-raw mc))
  844.  
  845.         ;; direct key => commit
  846.         (direct
  847.           (im-commit mc direct))
  848.  
  849.     ;; space key => commit
  850.     ((mana-space-key? key key-state)
  851.      (if (mana-context-alnum mc)
  852.          (im-commit mc (list-ref
  853.                 ja-alnum-space
  854.                 (- (mana-context-alnum-type mc)
  855.                    mana-type-halfwidth-alnum)))
  856.          (im-commit mc (list-ref ja-space (mana-context-kana-mode mc)))))
  857.      
  858.         ((symbol? key)
  859.          (mana-commit-raw mc))
  860.  
  861.         (else
  862.      (if (mana-context-alnum mc)
  863.          (let ((key-str (charcode->string key)))
  864.            (ustr-insert-elem! (mana-context-preconv-ustr mc)
  865.                   (if (= (mana-context-alnum-type mc)
  866.                      mana-type-halfwidth-alnum)
  867.                       (list key-str key-str key-str)
  868.                       (list (ja-wide key-str) (ja-wide key-str)
  869.                         (ja-wide key-str))))
  870.            (ustr-insert-elem! (mana-context-raw-ustr mc) key-str))
  871.          (let* ((key-str (charcode->string
  872.                   (if (= rule mana-input-rule-kana)
  873.                   key
  874.                   (ichar-downcase key))))
  875.             (res (rk-push-key! rkc key-str)))
  876.            (if res
  877.            (begin
  878.              (ustr-insert-elem! (mana-context-preconv-ustr mc)
  879.                     res)
  880.              (ustr-insert-elem! (mana-context-raw-ustr mc)
  881.                     key-str))
  882.            (if (null? (rk-context-seq rkc))
  883.                (mana-commit-raw mc))))))))))
  884.  
  885. (define mana-has-preedit?
  886.   (lambda (mc)
  887.     (or (not (ustr-empty? (mana-context-preconv-ustr mc)))
  888.         (> (string-length (rk-pending (mana-context-rkc mc))) 0))))
  889.  
  890. (define mana-rotate-transposing-alnum-type
  891.   (lambda (cur-type state)
  892.     (cond
  893.      ((and
  894.        (= cur-type mana-type-halfwidth-alnum)
  895.        (= state mana-type-halfwidth-alnum))
  896.       mana-candidate-type-upper-halfwidth-alnum)
  897.      ((and
  898.        (= cur-type mana-type-fullwidth-alnum)
  899.        (= state mana-type-fullwidth-alnum))
  900.       mana-candidate-type-upper-fullwidth-alnum)
  901.      (else
  902.       state))))
  903.  
  904. (define mana-proc-transposing-state
  905.   (lambda (mc key key-state)
  906.     (let ((rotate-list '())
  907.       (state #f))
  908.       (if (mana-transpose-as-fullwidth-alnum-key? key key-state)
  909.       (set! rotate-list (cons mana-type-fullwidth-alnum rotate-list)))
  910.       (if (mana-transpose-as-halfwidth-alnum-key? key key-state)
  911.       (set! rotate-list (cons mana-type-halfwidth-alnum rotate-list)))
  912.       (if (mana-transpose-as-halfkana-key? key key-state)
  913.       (set! rotate-list (cons mana-type-halfkana rotate-list)))
  914.       (if (mana-transpose-as-katakana-key? key key-state)
  915.       (set! rotate-list (cons mana-type-katakana rotate-list)))
  916.       (if (mana-transpose-as-hiragana-key? key key-state)
  917.       (set! rotate-list (cons mana-type-hiragana rotate-list)))
  918.  
  919.       (if (mana-context-transposing mc)
  920.       (let ((lst (member (mana-context-transposing-type mc) rotate-list)))
  921.         (if (and lst
  922.                  (not (null? (cdr lst))))
  923.         (set! state (car (cdr lst)))
  924.         (if (not (null? rotate-list))
  925.             (set! state (mana-rotate-transposing-alnum-type
  926.                  (mana-context-transposing-type mc)
  927.                  (car rotate-list))))))
  928.       (begin
  929.         (mana-context-set-transposing! mc #t)
  930.         (set! state (car rotate-list))))
  931.  
  932.       (cond
  933.        ((and state
  934.          (or
  935.           (= state mana-type-hiragana)
  936.           (= state mana-type-katakana)
  937.           (= state mana-type-halfkana)))
  938.     (mana-context-set-transposing-type! mc state))
  939.        ((and state
  940.          (or
  941.           (= state mana-type-halfwidth-alnum)
  942.           (= state mana-candidate-type-upper-halfwidth-alnum)
  943.           (= state mana-type-fullwidth-alnum)
  944.           (= state mana-candidate-type-upper-fullwidth-alnum)))
  945.     (if (not (= (mana-context-input-rule mc)
  946.             mana-input-rule-kana))
  947.         (mana-context-set-transposing-type! mc state)))
  948.        (else
  949.     (and
  950.      ; commit
  951.      (if (mana-commit-key? key key-state)
  952.          (begin
  953.            (im-commit mc (mana-transposing-text mc))
  954.            (mana-flush mc)
  955.            #f)
  956.          #t)
  957.      ; begin-conv
  958.      (if (mana-begin-conv-key? key key-state)
  959.          (begin
  960.            (mana-context-set-transposing! mc #f)
  961.            (mana-begin-conv mc)
  962.            #f)
  963.          #t)
  964.      ; cancel
  965.      (if (or
  966.           (mana-cancel-key? key key-state)
  967.           (mana-backspace-key? key key-state))
  968.          (begin
  969.            (mana-context-set-transposing! mc #f)
  970.            #f)
  971.          #t)
  972.      ; ignore
  973.      (if (or
  974.           (mana-prev-page-key? key key-state)
  975.           (mana-next-page-key? key key-state)
  976.           (mana-extend-segment-key? key key-state)
  977.           (mana-shrink-segment-key? key key-state)
  978.           (mana-next-segment-key? key key-state)
  979.           (mana-prev-segment-key? key key-state)
  980.           (mana-beginning-of-preedit-key? key key-state)
  981.           (mana-end-of-preedit-key? key key-state)
  982.           (mana-next-candidate-key? key key-state)
  983.           (mana-prev-candidate-key? key key-state)
  984.           (and (modifier-key-mask key-state)
  985.            (not (shift-key-mask key-state)))
  986.           (symbol? key))
  987.          #f
  988.          #t)
  989.      ; implicit commit
  990.      (begin
  991.        (im-commit mc (mana-transposing-text mc))
  992.        (mana-flush mc)
  993.        (mana-proc-input-state mc key key-state))))))))
  994.  
  995. (define mana-proc-input-state-with-preedit
  996.   (lambda (mc key key-state)
  997.     (let ((preconv-str (mana-context-preconv-ustr mc))
  998.           (raw-str (mana-context-raw-ustr mc))
  999.           (rkc (mana-context-rkc mc))
  1000.           (kana (mana-context-kana-mode mc))
  1001.           (rule (mana-context-input-rule mc)))
  1002.       (cond
  1003.  
  1004.        ;; begin conversion
  1005.        ((mana-begin-conv-key? key key-state)
  1006.     (mana-begin-conv mc))
  1007.  
  1008.        ;; backspace
  1009.        ((mana-backspace-key? key key-state)
  1010.     (if (not (rk-backspace rkc))
  1011.         (begin
  1012.           (ustr-cursor-delete-backside! preconv-str)
  1013.           (ustr-cursor-delete-backside! raw-str)
  1014.           ;; fix to valid roma
  1015.           (if (and
  1016.            (= (mana-context-input-rule mc) mana-input-rule-roma)
  1017.            (not (null? (ustr-former-seq preconv-str)))
  1018.            (not (ichar-printable?    ;; check for kana
  1019.              (string->ichar
  1020.               (car (last (ustr-former-seq preconv-str)))))))
  1021.           (ja-fix-deleted-raw-str-to-valid-roma! raw-str)))))
  1022.  
  1023.        ;; delete
  1024.        ((mana-delete-key? key key-state)
  1025.     (if (not (rk-delete rkc))
  1026.         (begin
  1027.           (ustr-cursor-delete-frontside! preconv-str)
  1028.           (ustr-cursor-delete-frontside! raw-str))))
  1029.  
  1030.        ;; kill
  1031.        ((mana-kill-key? key key-state)
  1032.     (ustr-clear-latter! preconv-str)
  1033.     (ustr-clear-latter! raw-str))
  1034.  
  1035.        ;; kill-backward
  1036.        ((mana-kill-backward-key? key key-state)
  1037.     (rk-flush rkc)
  1038.     (ustr-clear-former! preconv-str)
  1039.     (ustr-clear-former! raw-str))
  1040.  
  1041.        ;; ╕╜║▀ñ╚ñ╧╡╒ñ╬ñ½ñ╩ÑΓí╝Ñ╔ñ╟ñ½ñ╩ñ≥│╬─Ωñ╣ñδ
  1042.        ((and
  1043.      (not (mana-context-alnum mc))
  1044.      (mana-commit-as-opposite-kana-key? key key-state))
  1045.     (im-commit mc (mana-make-whole-string mc #t (ja-opposite-kana kana)))
  1046.     (mana-flush mc))
  1047.  
  1048.        ;; Transposing╛⌡┬╓ñ╪░▄╣╘
  1049.        ((or (mana-transpose-as-hiragana-key? key key-state)
  1050.         (mana-transpose-as-katakana-key? key key-state)
  1051.         (mana-transpose-as-halfkana-key? key key-state)
  1052.         (and
  1053.          (not (= (mana-context-input-rule mc) mana-input-rule-kana))
  1054.          (or
  1055.           (mana-transpose-as-halfwidth-alnum-key? key key-state)
  1056.           (mana-transpose-as-fullwidth-alnum-key? key key-state))))
  1057.     (mana-proc-transposing-state mc key key-state))
  1058.  
  1059.        ((mana-hiragana-key? key key-state)
  1060.     (if (not (= kana mana-type-hiragana))
  1061.         (begin
  1062.           (im-commit mc (mana-make-whole-string mc #t kana))
  1063.           (mana-flush mc)))
  1064.     (mana-context-set-kana-mode! mc mana-type-hiragana)
  1065.     (mana-context-set-alnum! mc #f))
  1066.  
  1067.        ((mana-katakana-key? key key-state)
  1068.     (if (not (= kana mana-type-katakana))
  1069.         (begin
  1070.           (im-commit mc (mana-make-whole-string mc #t kana))
  1071.           (mana-flush mc)))
  1072.     (mana-context-set-kana-mode! mc mana-type-katakana)
  1073.     (mana-context-set-alnum! mc #f))
  1074.  
  1075.        ((mana-halfkana-key? key key-state)
  1076.     (if (not (= kana mana-type-halfkana))
  1077.         (begin
  1078.           (im-commit mc (mana-make-whole-string mc #t kana))
  1079.           (mana-flush mc)))
  1080.     (mana-context-set-kana-mode! mc mana-type-halfkana)
  1081.     (mana-context-set-alnum! mc #f))
  1082.  
  1083.        ((and
  1084.          (mana-halfwidth-alnum-key? key key-state)
  1085.      (not
  1086.       (and
  1087.        (= (mana-context-alnum-type mc) mana-type-halfwidth-alnum)
  1088.        (mana-context-alnum mc))))
  1089.     (mana-context-set-alnum-type! mc mana-type-halfwidth-alnum)
  1090.     (mana-context-set-alnum! mc #t))
  1091.  
  1092.        ((and
  1093.          (mana-fullwidth-alnum-key? key key-state)
  1094.      (not
  1095.       (and
  1096.        (= (mana-context-alnum-type mc) mana-type-fullwidth-alnum)
  1097.        (mana-context-alnum mc))))
  1098.     (mana-context-set-alnum-type! mc mana-type-fullwidth-alnum)
  1099.     (mana-context-set-alnum! mc #t))
  1100.  
  1101.        ;; Commit current preedit string, then toggle hiragana/katakana mode.
  1102.        ((and
  1103.      (not (mana-context-alnum mc))
  1104.      (mana-kana-toggle-key? key key-state))
  1105.     (im-commit mc (mana-make-whole-string mc #t kana))
  1106.     (mana-flush mc)
  1107.     (mana-context-kana-toggle mc))
  1108.  
  1109.        ((mana-alkana-toggle-key? key key-state)
  1110.     (mana-context-alkana-toggle mc))
  1111.  
  1112.        ;; cancel
  1113.        ((mana-cancel-key? key key-state)
  1114.     (mana-flush mc))
  1115.  
  1116.        ;; commit
  1117.        ((mana-commit-key? key key-state)
  1118.     (begin
  1119.       (im-commit
  1120.        mc
  1121.        (mana-make-whole-string mc #t kana))
  1122.       (mana-flush mc)))
  1123.  
  1124.        ;; left
  1125.        ;; 2004-08-27 Takuro Ashie <ashie@homa.ne.jp>
  1126.        ;;   * We should restore pending state of rk-context when the input-rule
  1127.        ;;     is kana mode.
  1128.        ((mana-go-left-key? key key-state)
  1129.     (mana-context-confirm-kana! mc)
  1130.     (ustr-cursor-move-backward! preconv-str)
  1131.     (ustr-cursor-move-backward! raw-str))
  1132.  
  1133.        ;; right
  1134.        ;; 2004-08-27 Takuro Ashie <ashie@homa.ne.jp>
  1135.        ;;   * We should restore pending state of rk-context when the input-rule
  1136.        ;;     is kana mode.
  1137.        ((mana-go-right-key? key key-state)
  1138.     (mana-context-confirm-kana! mc)
  1139.     (ustr-cursor-move-forward! preconv-str)
  1140.     (ustr-cursor-move-forward! raw-str))
  1141.  
  1142.        ;; beginning-of-preedit
  1143.        ;; 2004-08-27 Takuro Ashie <ashie@homa.ne.jp>
  1144.        ;;   * We should restore pending state of rk-context when the input-rule
  1145.        ;;     is kana mode.
  1146.        ((mana-beginning-of-preedit-key? key key-state)
  1147.     (mana-context-confirm-kana! mc)
  1148.     (ustr-cursor-move-beginning! preconv-str)
  1149.     (ustr-cursor-move-beginning! raw-str))
  1150.  
  1151.        ;; end-of-preedit
  1152.        ;; 2004-08-27 Takuro Ashie <ashie@homa.ne.jp>
  1153.        ;;   * We should restore pending state of rk-context when the input-rule
  1154.        ;;     is kana mode.
  1155.        ((mana-end-of-preedit-key? key key-state)
  1156.     (mana-context-confirm-kana! mc)
  1157.     (ustr-cursor-move-end! preconv-str)
  1158.     (ustr-cursor-move-end! raw-str))
  1159.  
  1160.        ;; modifiers (except shift) => ignore
  1161.        ((and (modifier-key-mask key-state)
  1162.          (not (shift-key-mask key-state)))
  1163.     #f)
  1164.  
  1165.        ((symbol? key)
  1166.         #f)
  1167.  
  1168.        (else
  1169.     ;; handle "n1" sequence as "ñ≤1"
  1170.     (if (and (not (mana-context-alnum mc))
  1171.          (not (ichar-alphabetic? key))
  1172.          (not (string-find
  1173.                (rk-expect rkc)
  1174.                (charcode->string
  1175.             (if (= rule mana-input-rule-kana)
  1176.                 key
  1177.                 (ichar-downcase key))))))
  1178.         (let ((pend (rk-pending rkc))
  1179.           (residual-kana (rk-push-key-last! rkc)))
  1180.           (if residual-kana
  1181.           (begin
  1182.             (ustr-insert-elem! preconv-str residual-kana)
  1183.             (ustr-insert-elem! raw-str pend)))))
  1184.  
  1185.     (if (mana-context-alnum mc)
  1186.         (let ((key-str (charcode->string key))
  1187.           (pend (rk-pending rkc))
  1188.           (residual-kana (rk-peek-terminal-match rkc)))
  1189.           (rk-flush rkc) ;; OK to reset rkc here.
  1190.           (if residual-kana
  1191.           (begin
  1192.             (ustr-insert-elem! preconv-str residual-kana)
  1193.             (ustr-insert-elem! raw-str pend)))
  1194.           (ustr-insert-elem! preconv-str
  1195.                  (if (= (mana-context-alnum-type mc)
  1196.                     mana-type-halfwidth-alnum)
  1197.                      (list key-str key-str key-str)
  1198.                      (list (ja-wide key-str) (ja-wide key-str)
  1199.                        (ja-wide key-str))))
  1200.           (ustr-insert-elem! raw-str key-str))
  1201.         (let* ((key-str (charcode->string 
  1202.                  (if (= rule mana-input-rule-kana)
  1203.                  key
  1204.                  (ichar-downcase key))))
  1205.            (pend (rk-pending rkc))
  1206.            (res (rk-push-key! rkc key-str)))
  1207.           (if (and res
  1208.                (or (list? (car res))
  1209.                (not (string=? (car res) ""))))
  1210.           (let ((next-pend (rk-pending rkc)))
  1211.             (if (list? (car res))
  1212.             (ustr-insert-seq!  preconv-str res)
  1213.             (ustr-insert-elem! preconv-str res))
  1214.             (if (and next-pend
  1215.                  (not (string=? next-pend "")))
  1216.             (ustr-insert-elem! raw-str pend)
  1217.             (if (list? (car res))
  1218.                 (begin
  1219.                   (ustr-insert-elem! raw-str pend)
  1220.                   (ustr-insert-elem! raw-str key-str))
  1221.                 (ustr-insert-elem!
  1222.                  raw-str
  1223.                  (string-append pend key-str)))))))))))))
  1224.  
  1225. (define mana-context-confirm-kana!
  1226.   (lambda (mc)
  1227.     (if (= (mana-context-input-rule mc)
  1228.            mana-input-rule-kana)
  1229.         (let* ((preconv-str (mana-context-preconv-ustr mc))
  1230.                (rkc (mana-context-rkc mc))
  1231.                (residual-kana (rk-peek-terminal-match rkc)))
  1232.           (if residual-kana
  1233.               (begin
  1234.                 (ustr-insert-elem! preconv-str residual-kana)
  1235.                 (rk-flush rkc)))))))
  1236.  
  1237. (define mana-proc-input-state
  1238.   (lambda (mc key key-state)
  1239.     (if (mana-has-preedit? mc)
  1240.         (mana-proc-input-state-with-preedit mc key key-state)
  1241.         (mana-proc-input-state-no-preedit mc key key-state))))
  1242.  
  1243. (define mana-separator
  1244.   (lambda (mc)
  1245.     (let ((attr (bitwise-ior preedit-separator
  1246.                  preedit-underline)))
  1247.       (if mana-show-segment-separator?
  1248.           (cons attr mana-segment-separator)
  1249.           #f))))
  1250.  
  1251. (define mana-context-transposing-state-preedit
  1252.   (lambda (mc)
  1253.     (let* ((transposing-text (mana-transposing-text mc)))
  1254.       (list (cons preedit-reverse transposing-text)
  1255.             (cons preedit-cursor "")))))
  1256.  
  1257. (define mana-transposing-text
  1258.   (lambda (mc)
  1259.     (let* ((transposing-type (mana-context-transposing-type mc)))
  1260.       (cond
  1261.        ((or
  1262.      (= transposing-type mana-type-hiragana)
  1263.      (= transposing-type mana-type-katakana)
  1264.      (= transposing-type mana-type-halfkana))
  1265.     (mana-make-whole-string mc #t transposing-type))
  1266.        ((= transposing-type mana-type-halfwidth-alnum)
  1267.     (mana-make-whole-raw-string mc #f #f))
  1268.        ((= transposing-type mana-candidate-type-upper-halfwidth-alnum)
  1269.     (mana-make-whole-raw-string mc #f #t))
  1270.        ((= transposing-type mana-type-fullwidth-alnum)
  1271.     (mana-make-whole-raw-string mc #t #f))
  1272.        ((= transposing-type mana-candidate-type-upper-fullwidth-alnum)
  1273.     (mana-make-whole-raw-string mc #t #t))))))
  1274.  
  1275. (define mana-converting-state-preedit
  1276.   (lambda (mc)
  1277.     (let* (
  1278.            (segments (mana-context-segments mc))
  1279.            (cur-seg (ustr-cursor-pos segments))
  1280.            (separator (mana-separator mc)))
  1281.       (append-map
  1282.         (lambda (seg-idx cand-idx)
  1283.           (let* ((attr (if (= seg-idx cur-seg)
  1284.                            (bitwise-ior preedit-reverse
  1285.                     preedit-cursor)
  1286.                            preedit-underline))
  1287.                  (cand (mana-get-nth-candidate mc seg-idx cand-idx))
  1288.                  (seg (list (cons attr cand))))
  1289.             (if (and separator
  1290.                      (< 0 seg-idx))
  1291.                 (cons separator seg)
  1292.                 seg)))
  1293.         (iota (ustr-length segments))
  1294.         (ustr-whole-seq segments)))))
  1295.  
  1296. (define mana-input-state-preedit
  1297.   (lambda (mc)
  1298.     (let* ((preconv-str (mana-context-preconv-ustr mc))
  1299.            (rkc (mana-context-rkc mc))
  1300.            (pending (rk-pending rkc))
  1301.            (kana (mana-context-kana-mode mc))
  1302.            (rule (mana-context-input-rule mc))
  1303.            (extract-kana
  1304.              (if (= rule mana-input-rule-kana)
  1305.                  (lambda (entry) (car entry))
  1306.                  (lambda (entry) (list-ref entry kana)))))
  1307.  
  1308.       (list
  1309.         (and (not (ustr-cursor-at-beginning? preconv-str))
  1310.              (cons preedit-underline
  1311.                    (string-append-map-ustr-former extract-kana preconv-str)))
  1312.         (and (> (string-length pending) 0)
  1313.              (cons preedit-underline pending))
  1314.         (and (mana-has-preedit? mc)
  1315.              (cons preedit-cursor ""))
  1316.         (and (not (ustr-cursor-at-end? preconv-str))
  1317.              (cons preedit-underline
  1318.                    (string-append-map-ustr-latter extract-kana preconv-str)))))))
  1319.  
  1320. (define mana-get-commit-path
  1321.   (lambda (mc)
  1322.     (let (
  1323.           (segments (mana-context-segments mc)))
  1324.       (map (lambda (seg-idx cand-idx)
  1325.          (if (> cand-idx mana-candidate-type-katakana)
  1326.          (mana-get-nth-path mc seg-idx cand-idx)
  1327.          (cons (mana-get-raw-candidate mc seg-idx cand-idx) '())))
  1328.            (iota (ustr-length segments))
  1329.            (ustr-whole-seq segments)))))
  1330.  
  1331. (define mana-commit-string
  1332.   (lambda (mc)
  1333.     '()))
  1334.  
  1335. (define mana-do-commit
  1336.   (lambda (mc)
  1337.     (let ((path (mana-get-commit-path mc))
  1338.           (yomi (mana-context-yomi mc))
  1339.           (yomi-len (mana-context-yomi-len mc))
  1340.       (segments (mana-context-segments mc)))
  1341.       ;; don't learn if one of the segments is transposing segment
  1342.       (if (every (lambda (x) (> x mana-candidate-type-katakana))
  1343.          (ustr-whole-seq segments))
  1344.       (mana-learn (mana-context-yomi mc) 0 0 yomi-len path))
  1345.       (im-commit mc (string-append-map car path))
  1346.       (mana-commit-string mc)
  1347.       (mana-reset-candidate-window mc)
  1348.       (mana-flush mc))))
  1349.  
  1350. (define mana-correct-segment-cursor
  1351.   (lambda (segments)
  1352.     (if (ustr-cursor-at-end? segments)
  1353.         (ustr-cursor-move-backward! segments))))
  1354.  
  1355. (define mana-move-segment
  1356.   (lambda (mc offset)
  1357.     (mana-reset-candidate-window mc)
  1358.     (let ((segments (mana-context-segments mc)))
  1359.       (ustr-cursor-move! segments offset)
  1360.       (mana-correct-segment-cursor segments))))
  1361.  
  1362. (define mana-resize-segment
  1363.   (lambda (mc cnt)
  1364.     (let* (
  1365.            (segments (mana-context-segments mc))
  1366.            (cur-seg (ustr-cursor-pos segments)))
  1367.       (mana-reset-candidate-window mc)
  1368.       (mana-resize-specified-segment mc cur-seg cnt)
  1369.       (let* ((resized-nseg (mana-context-nr-segments mc))
  1370.              (latter-nseg (- resized-nseg cur-seg)))
  1371.         (ustr-set-latter-seq! segments (make-list latter-nseg 0))))))
  1372.  
  1373. (define mana-move-candidate
  1374.   (lambda (mc offset)
  1375.     (let* (
  1376.            (segments (mana-context-segments mc))
  1377.            (cur-seg (ustr-cursor-pos segments))
  1378.            (max (mana-get-nr-candidates mc cur-seg))
  1379.            (n (if (< (ustr-cursor-frontside segments) 0) ;; segment-transposing
  1380.           0
  1381.           (+ (ustr-cursor-frontside segments) offset)))
  1382.            (compensated-n (cond
  1383.                             ((>= n max)
  1384.                              0)
  1385.                             ((< n 0)
  1386.                              (- max 1))
  1387.                             (else
  1388.                               n)))
  1389.            (new-op-count (+ 1 (mana-context-candidate-op-count mc))))
  1390.       (ustr-cursor-set-frontside! segments compensated-n)
  1391.       (mana-context-set-candidate-op-count! mc new-op-count)
  1392.       (if (and mana-use-candidate-window?
  1393.                (= (mana-context-candidate-op-count mc)
  1394.                   mana-candidate-op-count))
  1395.           (begin
  1396.             (mana-context-set-candidate-window! mc #t)
  1397.             (im-activate-candidate-selector mc max mana-nr-candidate-max)))
  1398.       (if (mana-context-candidate-window mc)
  1399.           (im-select-candidate mc compensated-n)))))
  1400.  
  1401. (define mana-move-candidate-in-page
  1402.   (lambda (mc numeralc)
  1403.     (let* (
  1404.            (segments (mana-context-segments mc))
  1405.            (cur-seg (ustr-cursor-pos segments))
  1406.            (max (mana-get-nr-candidates mc cur-seg))
  1407.            (n (ustr-cursor-frontside segments))
  1408.            (cur-page (if (= mana-nr-candidate-max 0)
  1409.                          0
  1410.                          (quotient n mana-nr-candidate-max)))
  1411.            (pageidx (- (numeric-ichar->integer numeralc) 1))
  1412.            (compensated-pageidx (cond
  1413.                                   ((< pageidx 0) ; pressing key_0
  1414.                                    (+ pageidx 10))
  1415.                                   (else
  1416.                                     pageidx)))
  1417.            (idx (+ (* cur-page mana-nr-candidate-max) compensated-pageidx))
  1418.            (compensated-idx (cond
  1419.                               ((>= idx max)
  1420.                                (- max 1))
  1421.                               (else
  1422.                                 idx)))
  1423.            (new-op-count (+ 1 (mana-context-candidate-op-count mc))))
  1424.       (ustr-cursor-set-frontside! segments compensated-idx)
  1425.       (mana-context-set-candidate-op-count! mc new-op-count)
  1426.       (im-select-candidate mc compensated-idx))))
  1427.  
  1428. (define mana-reset-candidate-window
  1429.   (lambda (mc)
  1430.     (if (mana-context-candidate-window mc)
  1431.         (begin
  1432.           (im-deactivate-candidate-selector mc)
  1433.           (mana-context-set-candidate-window! mc #f)))
  1434.     (mana-context-set-candidate-op-count! mc 0)))
  1435.  
  1436. (define mana-rotate-segment-transposing-alnum-type
  1437.   (lambda (idx state)
  1438.     (cond
  1439.      ((and
  1440.        (= idx mana-candidate-type-halfwidth-alnum)
  1441.        (= state mana-candidate-type-halfwidth-alnum))
  1442.       mana-candidate-type-upper-halfwidth-alnum)
  1443.      ((and
  1444.        (= idx mana-candidate-type-fullwidth-alnum)
  1445.        (= state mana-candidate-type-fullwidth-alnum))
  1446.       mana-candidate-type-upper-fullwidth-alnum)
  1447.      (else
  1448.       state))))
  1449.  
  1450. (define mana-set-segment-transposing
  1451.   (lambda (mc key key-state)
  1452.     (let ((segments (mana-context-segments mc)))
  1453.       (let ((rotate-list '())
  1454.         (state #f)
  1455.         (idx (ustr-cursor-frontside segments)))
  1456.     (mana-reset-candidate-window mc)
  1457.     (mana-context-set-candidate-op-count! mc 0)
  1458.  
  1459.     (if (mana-transpose-as-fullwidth-alnum-key? key key-state)
  1460.         (set! rotate-list (cons mana-candidate-type-fullwidth-alnum
  1461.                     rotate-list)))
  1462.     (if (mana-transpose-as-halfwidth-alnum-key? key key-state)
  1463.         (set! rotate-list (cons mana-candidate-type-halfwidth-alnum
  1464.                     rotate-list)))
  1465.     (if (mana-transpose-as-halfkana-key? key key-state)
  1466.         (set! rotate-list (cons mana-candidate-type-halfkana
  1467.                     rotate-list)))
  1468.     (if (mana-transpose-as-katakana-key? key key-state)
  1469.         (set! rotate-list (cons mana-candidate-type-katakana
  1470.                     rotate-list)))
  1471.     (if (mana-transpose-as-hiragana-key? key key-state)
  1472.         (set! rotate-list (cons mana-candidate-type-hiragana
  1473.                     rotate-list)))
  1474.     (if (or
  1475.          (= idx mana-candidate-type-hiragana)
  1476.          (= idx mana-candidate-type-katakana)
  1477.          (= idx mana-candidate-type-halfkana)
  1478.          (= idx mana-candidate-type-halfwidth-alnum)
  1479.          (= idx mana-candidate-type-fullwidth-alnum)
  1480.          (= idx mana-candidate-type-upper-halfwidth-alnum)
  1481.          (= idx mana-candidate-type-upper-fullwidth-alnum))
  1482.         (let ((lst (member idx rotate-list)))
  1483.           (if (and lst
  1484.                (not (null? (cdr lst))))
  1485.           (set! state (car (cdr lst)))
  1486.           (set! state (mana-rotate-segment-transposing-alnum-type
  1487.                        idx (car rotate-list)))))
  1488.         (set! state (car rotate-list)))
  1489.     (ustr-cursor-set-frontside! segments state)))))
  1490.  
  1491. (define mana-proc-converting-state
  1492.   (lambda (mc key key-state)
  1493.     (cond
  1494.       ((mana-prev-page-key? key key-state)
  1495.        (if (mana-context-candidate-window mc)
  1496.            (im-shift-page-candidate mc #f)))
  1497.  
  1498.       ((mana-next-page-key? key key-state)
  1499.        (if (mana-context-candidate-window mc)
  1500.            (im-shift-page-candidate mc #t)))
  1501.  
  1502.       ((mana-commit-key? key key-state)
  1503.        (mana-do-commit mc))
  1504.  
  1505.       ((mana-extend-segment-key? key key-state)
  1506.        (mana-resize-segment mc 1))
  1507.  
  1508.       ((mana-shrink-segment-key? key key-state)
  1509.        (mana-resize-segment mc -1))
  1510.  
  1511.       ((mana-next-segment-key? key key-state)
  1512.        (mana-move-segment mc 1))
  1513.  
  1514.       ((mana-prev-segment-key? key key-state)
  1515.        (mana-move-segment mc -1))
  1516.  
  1517.       ((mana-beginning-of-preedit-key? key key-state)
  1518.        (begin
  1519.          (ustr-cursor-move-beginning! (mana-context-segments mc))
  1520.          (mana-reset-candidate-window mc)))
  1521.  
  1522.       ((mana-end-of-preedit-key? key key-state)
  1523.        (begin
  1524.          (ustr-cursor-move-end! (mana-context-segments mc))
  1525.          (mana-correct-segment-cursor (mana-context-segments mc))
  1526.          (mana-reset-candidate-window mc)))
  1527.  
  1528.       ((mana-backspace-key? key key-state)
  1529.        (mana-cancel-conv mc))
  1530.  
  1531.       ((mana-next-candidate-key? key key-state)
  1532.        (mana-move-candidate mc 1))
  1533.  
  1534.       ((mana-prev-candidate-key? key key-state)
  1535.        (mana-move-candidate mc -1))
  1536.  
  1537.       ((or (mana-transpose-as-hiragana-key? key key-state)
  1538.        (mana-transpose-as-katakana-key? key key-state)
  1539.        (mana-transpose-as-halfkana-key? key key-state)
  1540.        (and
  1541.         (not (= (mana-context-input-rule mc) mana-input-rule-kana))
  1542.         (or
  1543.          (mana-transpose-as-halfwidth-alnum-key? key key-state)
  1544.          (mana-transpose-as-fullwidth-alnum-key? key key-state))))
  1545.        (mana-set-segment-transposing mc key key-state))
  1546.  
  1547.       ((mana-cancel-key? key key-state)
  1548.        (mana-cancel-conv mc))
  1549.  
  1550.       ((and mana-select-candidate-by-numeral-key?
  1551.             (ichar-numeric? key)
  1552.             (mana-context-candidate-window mc))
  1553.        (mana-move-candidate-in-page mc key))
  1554.  
  1555.       ;; don't discard shift-modified keys. Some of them ("?", "~",
  1556.       ;; etc) are used to implicit commit. Reported by [mana-dev 745]
  1557.       ;; -- YamaKen 2004-04-08
  1558.       ((and (modifier-key-mask key-state)
  1559.             (not (shift-key-mask key-state)))
  1560.        #f)  ;; use #f rather than () to conform to R5RS
  1561.  
  1562.       ((symbol? key)
  1563.        #f)
  1564.  
  1565.       (else
  1566.         (begin
  1567.           (mana-do-commit mc)
  1568.           (mana-proc-input-state mc key key-state))))))
  1569.  
  1570. (define mana-press-key-handler
  1571.   (lambda (mc key key-state)
  1572.     (if (ichar-control? key)
  1573.         (im-commit-raw mc)
  1574.         (if (mana-context-on mc)
  1575.             (if (mana-context-transposing mc)
  1576.                 (mana-proc-transposing-state mc key key-state)
  1577.                 (if (mana-context-converting mc)
  1578.                     (mana-proc-converting-state mc key key-state)
  1579.                     (mana-proc-input-state mc key key-state)))
  1580.         (mana-proc-raw-state mc key key-state)))
  1581.     ;; preedit
  1582.     (mana-update-preedit mc)))
  1583.  
  1584.  
  1585. (define mana-release-key-handler
  1586.   (lambda (mc key key-state)
  1587.     (if (or (ichar-control? key)
  1588.             (not (mana-context-on mc)))
  1589.         ;; don't discard key release event for apps
  1590.         (mana-commit-raw mc))))
  1591.  
  1592. (define mana-reset-handler
  1593.   (lambda (mc)
  1594.     (if (mana-context-on mc)
  1595.         (mana-flush mc))
  1596.     ;; code to commit pending string must not be added to here.
  1597.     ;; -- YamaKen 2004-10-21
  1598.     ))
  1599.  
  1600. (define mana-get-candidate-handler
  1601.   (lambda (mc idx accel-enum-hint)
  1602.     (let* (
  1603.            (cur-seg (ustr-cursor-pos (mana-context-segments mc)))
  1604.            (cand (mana-get-nth-candidate mc cur-seg idx)))
  1605.       (list cand (digit->string (+ idx 1)) ""))))
  1606.  
  1607. (define mana-set-candidate-index-handler
  1608.   (lambda (mc idx)
  1609.     (ustr-cursor-set-frontside! (mana-context-segments mc) idx)
  1610.     ;    (mana-move-segment mc 1)
  1611.     (mana-update-preedit mc)))
  1612.  
  1613. (mana-configure-widgets)
  1614.  
  1615. (register-im
  1616.   'mana
  1617.   "ja"
  1618.   "EUC-JP"
  1619.   mana-im-name-label
  1620.   mana-im-short-desc
  1621.   #f
  1622.   mana-init-handler
  1623.   mana-release-handler
  1624.   context-mode-handler
  1625.   mana-press-key-handler
  1626.   mana-release-key-handler
  1627.   mana-reset-handler
  1628.   mana-get-candidate-handler
  1629.   mana-set-candidate-index-handler
  1630.   context-prop-activate-handler
  1631.   #f
  1632.   #f
  1633.   #f
  1634.   #f
  1635.   #f
  1636.   )
  1637.